home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 06 - 1990 / 06.12 Dec 90 / Pattern Scroller / PatternScroller.Pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-07  |  4.6 KB  |  178 lines  |  [TEXT/TPAS]
  1. {$D+}  {generate debug symbols}
  2. Program PatternScroller;
  3. {**** written and © 1989 by Shelly Mendlinger
  4.  **** Brooklyn, New York}
  5.  
  6. {$R PatList.RSRC}  {identify res file}
  7. {$U-}              {No defaults. We'll roll our own}
  8. uses
  9.     memtypes,
  10.     quickdraw,
  11.     osintf,
  12.     toolintf,
  13.     packintf;
  14. const
  15.     LdefNum = 1000;
  16.     title = 'PatternScroller  ©1989 by Shelly Mendlinger';
  17. var
  18.     Rview,
  19.     dBounds,
  20.     Wrect,
  21.     totRect,
  22.     testRect    : rect;
  23.     cSize       : point;
  24.     theCell     : cell;
  25.     wind        : windowPtr;
  26.     theList     : listHandle;
  27.     thePat      : pattern;
  28.     index,
  29.     dLen,
  30.     theProc     : integer;
  31.     str         : str255;
  32.     event       : eventRecord;
  33.     aHand       : handle;
  34.     aCell       : cell;
  35.     over,
  36.     bool,
  37.     drawIt,
  38.     hasGrow,
  39.     scrollHoriz,
  40.     scrollVert  : boolean;
  41.  
  42. Procedure ShowPat;
  43. begin
  44.     {--- set vars ---}
  45.     dLen := 8;
  46.     setPt(theCell,0,0);
  47.     {--- get current selection ---}
  48.     bool := LGetSelect(true,theCell,theList);
  49.     {--- get cell data ---}
  50.     LGetCell(@thePat,dLen,theCell,theList);
  51.     {--- show pat ---}
  52.     fillrect(testRect,thePat);
  53.     framerect(testrect);
  54. end;{proc show pat}
  55.  
  56. Procedure Initialize;
  57. begin
  58.     {--- Let the Games Begin ---}
  59.     initGraf(@thePort);
  60.     initFonts;
  61.     initWindows;
  62.     initCursor;
  63.     {--- open a window ---}
  64.     setrect(wRect,10,50,500,330);
  65.     wind := newWindow(nil,wRect,title,true,0,pointer(-1),true,0);
  66.     setPort(wind);
  67.     flushEvents(everyevent,0);
  68. end;{proc init}
  69.  
  70. Procedure SetUpList;
  71. begin
  72.     {--- set parameters ---}
  73.     setRect(Rview,100,20,340,50);{drawing area, local coords}
  74.     setrect(dBounds,0,0,38,1);{38 long,1 high}
  75.     setPt(cSize,30,30);{30X30 pixel cells}
  76.     theProc := LDefNUm;{LDEF ID}
  77.     drawIt  := false;  {turn off drawinf=g}
  78.     hasgrow := false;  {no grow box}
  79.     scrollHoriz := true;{yes horiz scroll bar}
  80.     scrollVert := false; {no vert scroll}
  81.     {--- start things going ---}
  82.     theList := LNew(Rview,dbounds,cSize,
  83.                 theProc,wind,drawIt,hasGrow,
  84.                 scrollHoriz,scrollVert);
  85.     {--- fill cells with pat data ---}
  86.     for index := 1 to 38 do
  87.       begin
  88.         setPt(theCell,index-1,0);
  89.         getIndPattern(thePat,sysPatListID,index);
  90.         LSetCell(@thePat,sizeof(pattern),theCell,theList);
  91.      end;{for index}
  92.     {--- draw the list ---}
  93.     LDoDraw(true,theList);
  94.     LUpdate(wind^.visRgn,theList);
  95.     {--- select starting pat ---}
  96.     setPt(theCell,3,0);
  97.     LsetSelect(true,theCell,theList);
  98.     totrect := Rview;
  99.     totRect.bottom := totRect.bottom + 15; {include scroll rect}
  100. end;{proc Set up list}
  101.  
  102. Procedure doTestRect;
  103. begin
  104.     setRect(testrect,100,100,340,250);
  105.     str:= 'Test Rect';
  106.     with testRect do
  107.     moveto(left+(right-left-stringWidth(str)) div 2,96);
  108.     drawstring(str);
  109.     Showpat;
  110. end;{proc do Test Rect} 
  111.  
  112. Procedure HandleEvent(evt : EventRecord);
  113. var
  114.     aPt,
  115.     pt2     : point;
  116.     aRect,
  117.     oldRect : rect;
  118.     long    : longint;
  119. begin
  120.     aPt := evt.where;
  121.     {--- what's happining? ---}
  122.     case evt.what of
  123.     keydown:    over := true;{any key quits}
  124.     mousedown:  case findWindow(aPt,wind) of
  125.             inGoAway: over := true;{say bye-bye}
  126.             inContent: begin
  127.                 setRect(oldRect,0,0,0,0);
  128.                 globalToLocal(aPt);
  129.                 {--- is click in list? ---}
  130.                 if ptInRect(aPt,totRect) then
  131.                   begin
  132.                     {--- get current selection ---}
  133.                     setPt(theCell,0,0);
  134.                    bool := LGetSelect(true,aCell,theList);
  135.                    {--- deselect old cell ---}
  136.                    LSetSelect(false,aCell,theList);
  137.                    {--- trach click ---}
  138.                    bool := LClick(aPt,evt.modifiers,theLIst);
  139.                    {--- is click in a pattern ---}
  140.                    if ptInRect(aPt,Rview) then
  141.                      begin
  142.                         {--- get new cell ---}
  143.                         long := LLastclick(theList);
  144.                         aCell := cell(long);
  145.                      end;{in pat}
  146.                    {--- select/reselect cell ---}
  147.                    LSetSelect(true,aCell,theList);
  148.                    ShowPat;
  149.                end;{in totRect}
  150.              end;{inContent}
  151.              otherwise
  152.            end;{case findwindow}
  153.            otherwise
  154.          end;{case what}
  155.  end;{proc handle event}
  156.  
  157. BEGIN {main}
  158.     Initialize;
  159.     SetUpList;
  160.     DoTestRect;
  161.     {--- do event loop ---}
  162.     over := false;
  163.     repeat
  164.         if getNextEvent(everyEvent,event) then
  165.             handleEvent(event) ;
  166.     until over;
  167.     {--- clean up --}
  168.     Ldispose(theList);
  169. end.{prog PatternScroller}   
  170.                
  171.                    
  172.     
  173.     
  174.     
  175.     
  176.     
  177.         
  178.